Pascal Super Library/Pascal Super Library (CW International)(1997).bin/SECURITY/MNGLR140/MANGLER.PAS

Pascal/Delphi Source File | 1996-05-01 | 53KB | 1,797 lines

{   Mangler, a program to mangle pascal source files.
    (c) Copyright 1993-1996 by Berend de Boer.

    This program is free software for noncommercial users; you can
    redistribute it and/or modify it under the terms of the license,
    stated in de accompanying file LICENSE.TXT.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    license for more details.

    See the accompanying READ.ME file for information on contacting the
    author.


$Author: Berend_de_Boer $
$Date: 94/03/19 20:31:37 $
$Revision: 1.35 $

Last changes to code:
}

{* conditional defines *}

{$DEFINE Crunch}                  { do crunch pass }
{$DEFINE DelTmpFiles}             { delete temporary files }
{{$DEFINE ShowProcs}               { show procedures }
{{$DEFINE ShowFreeItem}            { show item being freed }

{$X+}
program Mangler;

uses
  LexLib,
{$IFDEF Debug}
  BBError, ObjMemory, PMD, MemCheck,
{$ENDIF}
  Objects, Dos;


const
  Version = '1.40';

const
  LineWidth:word = 120;
  Prime = 67099547;

const
{* this list should be sorted! *}
  _ABSOLUTE = 1;
  _AND = 2;
  _ARRAY = 3;
  _ASM = 4;
  _ASSEMBLER = 5;
  _BEGIN = 6;
  _CASE = 7;
  _CONST = 8;
  _CONSTRUCTOR = 9;
  _DESTRUCTOR = 10;
  _DIV = 11;
  _DO = 12;
  _DOWNTO = 13;
  _ELSE = 14;
  _END = 15;
  _EXTERNAL = 16;
  _FAR = 17;
  _FILE = 18;
  _FOR = 19;
  _FORWARD = 20;
  _FUNCTION = 21;
  _GOTO = 22;
  _IF = 23;
  _IMPLEMENTATION = 24;
  _IN = 25;
  _INHERITED = 26;
  _INLINE = 27;
  _INTERFACE = 28;
  _INTERRUPT = 29;
  _LABEL = 30;
  _MOD = 31;
  _NEAR = 32;
  _NIL = 33;
  _NOT = 34;
  _OBJECT = 35;
  _OF = 36;
  _OR = 37;
  _PACKED = 38;
  _PRIVATE = 39;
  _PROCEDURE = 40;
  _PROGRAM = 41;
  _PUBLIC = 42;
  _RECORD = 43;
  _REPEAT = 44;
  _SET = 45;
  _SHL = 46;
  _SHR = 47;
  _STRING = 48;
  _THEN = 49;
  _TO = 50;
  _TYPE = 51;
  _UNIT = 52;
  _UNTIL = 53;
  _USES = 54;
  _VAR = 55;
  _VIRTUAL = 56;
  _WHILE = 57;
  _WITH = 58;
  _XOR = 59;
  SEMICOLON = 100;
  CHARACTER_STRING = 101;
  IDENTIFIER = 102;
  DOT = 103;
  DIRECTIVE = 104;
  NUMBER = 105;
  ASSIGNMENT = 106;
  COLON = 107;
  EQUAL = 108;
  LPAREN = 109;
  RPAREN = 110;
  COMMA = 111;
  OTHER = 112;
  DOTDOT = 113;
  GE = 114;
  LE = 115;
  NOTEQUAL = 116;
  _CHAR = 117;
  NEWLINE = 118;
  KEYWORD = 119;
  UPARROW = 120;
  AMPERSAND = 121;
  LBRAC = 122;
  RBRAC = 123;

type
  PScopeCol = ^TScopeCol;

  PMangleItem = ^TMangleIteM;
  TMangleItem = record
    Name : PString;
    HashedName : PString;
    ScopeCol : PScopeCol;
    ScopeCopy: Boolean;
  end;

  TScopeCol = object(TStringCollection)
    Owner: PMangleItem;
    procedure FreeItem(Item : pointer);  virtual;
    procedure Insert(Item : pointer);  virtual;
    function  KeyOf(Item : pointer) : pointer;  virtual;
    function  InsertIntrIdentifier(const Name : string; var Index : integer) : string;
    function  InsertIdentifier(const Name : string; var Index : integer) : string;
    function  AtHashedName(Index : integer) : string;
    function  AtScope(Index : integer) : PScopeCol;
    function  LastScope : PScopeCol;
  end;


  SectionTypes = (None, Decl, BetweenCaseAndOfDecl,
                  Func, FuncDecl, FuncOuter, FunctionType,
                  CompoundStatement, WithStatement, Inlin, LabelStatement);

  PSectionItem = ^TSectionItem;
  TSectionItem = record
    Section : SectionTypes;
    WithPushes,
    OpeningLevel,
    DeclType : integer;
  end;

  PSectionCol = ^TSectionCol;
  TSectionCol = object(TStringCollection)
    procedure FreeItem(Item : pointer);  virtual;
  end;

  PForwardPointer = ^TForwardPointer;
  TForwardPointer = record
    PointerName,
    TypeName: PString;
  end;

  PForwardPointerCol = ^TForwardPointerCol;
  TForwardPointerCol = object(TStringCollection)
    procedure FreeItem(Item: pointer);  virtual;
    function  KeyOf(Item: pointer): pointer;  virtual;
    procedure InsertItem(const APointerName, ATypeName: string);
  end;

var
  sourceDir : DirStr;
  DirInfo : SearchRec;
  ExitSave : pointer;
  ImplementationLineNumber : word;


function HashIt(s : string) : string;
const
  Base = 5;
  chars:array [0..Base-1] of char = ('0', '1', 'I', 'O', 'l');

  function StrBase(l : longint) : string;
  var
    s : string;
  begin
    s := '';
    while l > Base-1 do  begin
      s := chars[l mod Base] + s;
      l := l div Base;
    end;  { of while }
    s := chars[l]+ s;
    StrBase := s;
  end;

var
  l, d : longint;
  i,j : word;
begin
  l := 0;
  Move(s[1], l, length(s) mod 4);
  j := length(s) mod 4 + 1;
  for i := 1 to length(s) div 4 do  begin
    Move(s[j], d, 4);
    l := l xor d;
    Inc(j, 4);
  end;  { of for }
  HashIt := 'O' + StrBase(Abs(l) mod Prime);
end;


procedure TScopeCol.FreeItem(Item : pointer);

  function AlsoUsesThisScope(Item2 : PMangleItem) : Boolean;  far;
  begin
    AlsoUsesThisScope := (Item2 <> Item) and
                         (Item2^.ScopeCol = PMangleItem(Item)^.ScopeCol);
  end;

var
  p : PMangleItem;
begin
  with PMangleItem(Item)^ do  begin
  {$IFDEF ShowFreeItem}
    writeln('Freeing: ', Name^);
  {$ENDIF}
    DisposeStr(Name);
    DisposeStr(HashedName);
    if (ScopeCol <> nil) and (not ScopeCopy) then  begin
    { check if more items use this ScopeCol, don't delete then! }
      p := FirstThat(@AlsoUsesThisScope);
      if p = nil then
        Dispose(ScopeCol, Done);
    end;
  end;
  Dispose(PMangleItem(Item));
end;

procedure TScopeCol.Insert(Item : pointer);
var
  Index : integer;
begin
  if Search(KeyOf(Item), Index)
   then  AtPut(Index, Item)
   else  AtInsert(Index, Item);
end;

function TScopeCol.KeyOf(Item : pointer) : pointer;
begin
  KeyOf := PMangleItem(Item)^.Name;
end;

function TScopeCol.InsertIntrIdentifier(const Name : string; var Index : integer) : string;
var
  p : PMangleItem;
begin
  New(p);
  p^.Name := NewStr(Name);
  p^.HashedName := NewStr(Name);
  p^.ScopeCol := nil;
  Insert(p);
  Index := IndexOf(p);
  InsertIntrIdentifier := p^.Name^;
end;

function TScopeCol.InsertIdentifier(const Name : string; var Index : integer) : string;
var
  p : PMangleItem;
begin
  New(p);
  p^.Name := NewStr(Name);
  p^.HashedName := NewStr(HashIt(Name));
  p^.ScopeCol := nil;
  Insert(p);
  Index := IndexOf(p);
  InsertIdentifier := p^.HashedName^;
end;

function TScopeCol.AtHashedName(Index : integer) : string;
begin
  AtHashedName := PMangleItem(At(Index))^.HashedName^;
end;

function TScopeCol.AtScope(Index : integer) : PScopeCol;
begin
  if Index = -1
   then  AtScope := nil
   else  AtScope := PMangleItem(At(Index))^.ScopeCol;
end;

function TScopeCol.LastScope : PScopeCol;
begin
  LastScope := PMangleItem(At(Count-1))^.ScopeCol;
end;


procedure TSectionCol.FreeItem(Item : pointer);
begin
  Dispose(PSectionItem(Item));
end;


procedure TForwardPointerCol.FreeItem(Item: pointer);
begin
  with PForwardPointer(Item)^ do  begin
    DisposeStr(PointerName);
    DisposeStr(TypeName);
  end;
  Dispose(PForwardPointer(Item));
end;

function TForwardPointerCol.KeyOf(Item: pointer): pointer;
begin
  KeyOf := PForwardPointer(Item)^.TypeName;
end;

procedure TForwardPointerCol.InsertItem(const APointerName, ATypeName: string);
var
  p: PForwardPointer;
begin
  New(p);
  p^.PointerName := NewStr(APointerName);
  p^.TypeName := NewStr(ATypeName);
  Insert(p);
end;


function UpStr(const s : string) : string;  assembler;
asm
  push   ds
  cld
  lds    si,s
  les    di,@Result
  lodsb
  stosb
  xor    ah,ah
  xchg   ax,cx
  jcxz   @3
@1:
  lodsb
  cmp    al,'a'
  jb     @2
  cmp    al,'z'
  ja     @2
  sub    al,20H
@2:
  stosb
  loop   @1
@3:
  pop    ds
end;



procedure WriteProgress;
{* writes current file with current linenumber *}
begin
  write(#13, sourceDir+DirInfo.Name, ' (', yylineno-1, ')');
end;

procedure ExitHandler;  far;
begin
  ExitProc := ExitSave;
  if TextRec(yyoutput).Mode <> fmClosed then  begin
    WriteProgress;
    Close(yyoutput);
  end;
end;

procedure Halt1;
{* stop program, delete temporary files*}
begin
  {$I-}
  Close(yyoutput);
{$IFDEF DelTmpFiles}
  Erase(yyoutput);
  {$I+}
{$ENDIF}
  Halt(1);
end;

procedure commenteof;
begin
  WriteProgress;
  writeln('  unexpected EOF inside comment');
  Halt1;
end;

function IsClosed(var t : text) : Boolean;
begin
  IsClosed := TextRec(t).Mode = fmClosed;
end;

procedure PrintError(const s : string);
begin
  WriteProgress;
  writeln('  ', s);
end;

function is_keyword(const id : string; var token : integer) : Boolean;
const
  id_len = 18;
type
  Ident = string[id_len];
const
  (* table of Pascal keywords: *)
  no_of_keywords = 59;
  keyword : array [1..no_of_keywords] of Ident = (
    'ABSOLUTE', 'AND', 'ARRAY', 'ASM', 'ASSEMBLER', 'BEGIN', 'CASE', 'CONST',
    'CONSTRUCTOR', 'DESTRUCTOR', 'DIV', 'DO',
    'DOWNTO', 'ELSE', 'END', 'EXTERNAL', 'FAR', 'FILE', 'FOR', 'FORWARD',
    'FUNCTION',
    'GOTO', 'IF', 'IMPLEMENTATION', 'IN', 'INHERITED', 'INLINE', 'INTERFACE',
    'INTERRUPT',
    'LABEL', 'MOD', 'NEAR', 'NIL', 'NOT', 'OBJECT', 'OF', 'OR',
    'PACKED', 'PRIVATE', 'PROCEDURE', 'PROGRAM', 'PUBLIC',
    'RECORD', 'REPEAT', 'SET', 'SHL', 'SHR', 'STRING', 'THEN', 'TO', 'TYPE',
    'UNIT', 'UNTIL', 'USES', 'VAR', 'VIRTUAL', 'WHILE', 'WITH', 'XOR');
var m, n, k : integer;
begin
  m := 1; n := no_of_keywords;
  while m<=n do  begin
    k := m+(n-m) div 2;
    if id=keyword[k]
     then  begin
       is_keyword := true;
       token := k;
       Exit;
     end
     else  if id>keyword[k]
            then  m := k+1
            else  n := k-1
  end;  { of while }
  is_keyword := false
end;


{$I PASLEX.PAS *}



function Scramble(FromFile, ToFile : FNameStr) : Boolean;
{* mangles a given file as much as possible *}
type
  RecordTypes = (rtNone, rtRecord, rtVariantRecord);
  PInteger = ^integer;
var
  LastScopeIndex : integer;
  Section : SectionTypes;
  DeclType : word;
  RecordType : RecordTypes;
  SectionStack : PSectionCol;
  ScopeStack : PCollection;
  CurrentScope : PScopeCol;
  ForwardPointerCol: PForwardPointerCol;
  WithPushes : integer;
  OpeningLevel : integer;
  ParenLevel : word;
  AssemblerSection : Boolean;
  ObjectImpl : Boolean;
  ConstantArray : Boolean;
  TypeCastDetected: Boolean;


  procedure PushScope(ps : PScopeCol);
  begin
    ScopeStack^.Insert(ps);
  end;

  function PopScope : PScopeCol;
  begin
    with ScopeStack^ do  begin
      PopScope := At(Count-1);
      AtDelete(Count-1);
    end;
  end;


  procedure PushSection(Section : SectionTypes);
  var
    p : PSectionItem;
  begin
    New(p);
    p^.Section := Section;
    p^.WithPushes := WithPushes;
    p^.OpeningLevel := OpeningLevel;
    p^.DeclType := DeclType;
    with SectionStack^ do
      AtInsert(Count, p);
  end;

  function PopSection : SectionTypes;
  var
    i : PInteger;
    p : PSectionItem;
  begin
    with SectionStack^ do
      p := At(Count-1);
    DeclType := p^.DeclType;
    OpeningLevel := p^.OpeningLevel;
    WithPushes := p^.WithPushes;
    PopSection := p^.Section;
    with SectionStack^ do
      AtFree(Count-1);
  end;

  procedure CreateCurrentScope;
  var
    Item: PMangleItem;
  begin
    CurrentScope := New(PScopeCol, Init(20,10));
    with ScopeStack^ do  begin
      Item := PMangleItem(PScopeCol(At(Count-1))^.At(LastScopeIndex));
      Item^.ScopeCol := CurrentScope;
      CurrentScope^.Owner := Item;
    end;
  end;

  function Encode(const s : string) : string;
  var
    Item: PMangleItem;
  begin
  {* create new scope if necessary *}
    if CurrentScope = nil then
      CreateCurrentScope;

  {* add identifier to current scope *}
    Encode := CurrentScope^.InsertIdentifier(s, LastScopeIndex);

  {* make the current identifier the new scope *}
    PushScope(CurrentScope);
    CurrentScope := CurrentScope^.AtScope(LastScopeIndex);
  end;

  function Encode2(const s : string) : string;
  {* as Encode but without setting a new scope *}
  var
    Index: integer;
  begin
    {* create new scope if necessary *}
    if CurrentScope = nil then
      CreateCurrentScope;

  {* add identifier to current scope *}
    Encode2 := CurrentScope^.InsertIdentifier(s, Index);
  end;

  function EncodeNot2(const s : string) : string;
  {* as Encode but without setting a new scope and without encoding *}
  var
    Index : integer;
  begin
    {* create new scope if necessary *}
    if CurrentScope = nil then
      CreateCurrentScope;

  {* add identifier to current scope *}
    EncodeNot2 := CurrentScope^.InsertIntrIdentifier(s, Index);
  end;

  function Encode3(const s : string) : string;
  {* inserts identifier in last scope on stack, sets scope of inserted
     identifier equal to current scope *}
  var
    Index : integer;
  begin
    with ScopeStack^, PScopeCol(At(Count-1))^ do  begin
      Encode3 := InsertIdentifier(s, Index);
      PMangleItem(At(Index))^.ScopeCol := CurrentScope;
    end;
  end;

  function EncodeNot3(const s : string) : string;
  { inserts identifier in last scope on stack, sets scope of inserted
    identifier equal to current scope, but don't encode }
  var
    Index : integer;
  begin
    with ScopeStack^, PScopeCol(At(Count-1))^ do  begin
      EncodeNot3 := InsertIntrIdentifier(s, Index);
      PMangleItem(At(Index))^.ScopeCol := CurrentScope;
    end;
  end;

  function EncodeNot(const s : string) : string;
  {* as Encode, but identifier is not mangled *}
  begin
    {* create new scope if necessary *}
    if CurrentScope = nil then
      CreateCurrentScope;

  {* add identifier to current scope *}
    CurrentScope^.InsertIntrIdentifier(s, LastScopeIndex);
    EncodeNot := s;

  {* make the current identifier the new scope *}
    PushScope(CurrentScope);
    CurrentScope := CurrentScope^.AtScope(LastScopeIndex);
  end;

  function GetScope(const s : string; var Index : integer) : PScopeCol;
  {* returns scope in which s was defined if exists *}

    function Containss(Item : PScopeCol) : Boolean;  far;
    begin
      Containss := (Item <> nil) and (Item^.Search(@s, Index));
    end;

  begin
    if (CurrentScope <> nil) and CurrentScope^.Search(@s, Index)
     then  GetScope := CurrentScope
     else
     {* search in scopes on ScopeStack *}
       GetScope := ScopeStack^.LastThat(@Containss);
  end;

  function GetMangleItem(const Name: string; var Item: PMangleItem): Boolean;
  var
    Scope: PScopeCol;
    Index: integer;
  begin
    Scope := GetScope(Name, Index);
    if Scope = nil
      then
        GetMangleItem := False
      else  begin
        GetMangleItem := True;
        Item := Scope^.At(Index);
      end;
  end;

  function GiveEncodingFor(s : string) : string;
  {* DO NOT MAKE s a const string!!! *}
  { PRE -
    POST - contents of yytext is destroyed
  }
  var
    p,d : PScopeCol;
    e : string;
    Index : integer;
  begin
    if yylex = DOT
     then  begin
     {* a dot was used to select a different scope *}
       p := GetScope(s, Index);
       if p = nil
        then  begin     {* an unknown scope was selected *}
          e := s + '.';
          while (yylex = IDENTIFIER) do  begin
            e := e + yytext;
            if yylex = DOT
             then  e := e + '.'
             else  Break;
          end;
          yyless(0);
        end
        else  begin
          PushScope(CurrentScope);
          CurrentScope := p^.AtScope(Index);
          e := p^.AtHashedName(Index) + '.';
          while (yylex = IDENTIFIER) do  begin
            if CurrentScope = nil
             then  begin
               e := e + yytext;
(* why this source??? if nil you don't know anything it seems
               d := GetScope(yytext, Index);
               if d <> nil
                then  e := e + GiveEncodingFor(yytext)
                else  e := e + yytext;
*)
             end
             else  begin
               if CurrentScope^.Search(@yytext, Index)
                then  e := e + CurrentScope^.AtHashedName(Index)
                else  e := e + yytext;
             end;
            if yylex = DOT
             then  begin
               if CurrentScope <> nil then
                 if CurrentScope^.Count = 0
                  then  CurrentScope := nil
                  else  CurrentScope := CurrentScope^.AtScope(Index);
               e := e + '.';
             end
             else  break;
          end;  { of while }
          yyless(0);
          CurrentScope := PopScope;
        end;
       GiveEncodingFor := e;
     end
     else  begin
       yyless(0);
       p := GetScope(s, Index);
       if p = nil
        then  GiveEncodingFor := s
        else  GiveEncodingFor := p^.AtHashedName(Index)
     end;
  end;





{$I ASMLEX.PAS}

var
  Buffer : array[1..1024] of char;
  GlobalSection : (Un, Intr, Impl);
  RightHand : Boolean;
  ObjectDecl : Boolean;
  Index : integer;           {* scratch variable *}
  ObjectName : string;
  i : integer;               {* scratch varaible *}
  Scope : PScopeCol;         {* scratch variable *}
  TypeDecl,
  AbsoluteParsed : Boolean;
  Paren : integer;
  LastRetVal : integer;      {* previous value of yyretval *}


  procedure HandleSemiColon;
  var
    i: integer;
    wp: integer;
    Index,
    PointerIndex: integer;
    TypeItem,
    PointerItem: PMangleItem;
  begin
    ConstantArray := FALSE;
    writeln(yyoutput, yytext);
    case GlobalSection of
      Intr : case Section of
               Decl : begin
                   if not ((RecordType = rtVariantRecord) and (LastRetVal = RPAREN)) then
                     RightHand := FALSE;
                   CurrentScope := PopScope;
                 end;
               Func, FunctionType : begin
                   CurrentScope := PopScope;
                   RightHand := FALSE;
                   Section := Decl;
                 end;
               FuncDecl : RightHand := FALSE;
             end; { of case }
      Impl : begin
               case Section of
                 Decl : begin
                     if not ((RecordType = rtVariantRecord) and (LastRetVal = RPAREN)) then
                       RightHand := FALSE;
                     if CurrentScope = nil
                       then
                         TypeItem := nil
                       else
                         TypeItem := CurrentScope^.Owner;
                     CurrentScope := PopScope;
                     if (TypeItem <> nil) and (ForwardPointerCol^.Count > 0) then  begin
                       while ForwardPointerCol^.Search(TypeItem^.Name, Index) do  begin
                         if GetMangleItem(PForwardPointer(ForwardPointerCol^.At(Index))^.PointerName^, PointerItem) then  begin
                            PointerItem^.ScopeCol := TypeItem^.ScopeCol;
                            PointerItem^.ScopeCopy := True;
                         end;
                         ForwardPointerCol^.AtFree(Index);
                       end;
                     end;
                   end;
                 Func : begin
                     if ObjectDecl then  begin
                        CurrentScope := PopScope;
                        Section := Decl;
                     end;
                   end;
                 FunctionType : begin
                     CurrentScope := PopScope;
                     RightHand := FALSE;
                     Section := Decl;
                   end;
                 FuncDecl : RightHand := FALSE;
                 WithStatement : begin
                     wp := WithPushes;
                     for i := 0 to wp-1 do
                       CurrentScope := PopScope;
                     Section := PopSection;
                   end;
                 Inlin : begin
                     Section := PopSection;
                     CurrentScope := PopScope;
                   end;
                 LabelStatement : begin
                     RightHand := FALSE;
                     Section := Decl;
                   end;
               end; { of case }
               if TypeCastDetected then  begin
                 CurrentScope := PopScope;
                 TypeCastDetected := False;
               end;
             end;
    end; { of case }
  end;  { of proc HandleSemiClon *}


  procedure ParseDeclaration;
  var
    i : integer;
    saveyytext : string;
    OldScope : PScopeCol;

    procedure SetNewScope(Item : PMangleItem);  far;
    begin
      if Item^.ScopeCol = OldScope then  begin
        Item^.ScopeCol := CurrentScope;
        Item^.ScopeCopy := True;
      end;
    end;

  begin
    if RightHand
     then  begin
       if not AbsoluteParsed then  begin
         Scope := GetScope(yytext, Index);
         if Scope <> nil then  begin
         { variable of mangled types should get the }

         { same scope as their type }
           Scope := Scope^.AtScope(Index);
           CurrentScope := Scope;
           with PMangleItem(PScopeCol(ScopeStack^.At(ScopeStack^.Count-1))^.At(LastScopeIndex))^ do  begin
             ScopeCopy := True;
             if ScopeCol = nil
              then  ScopeCol := CurrentScope
              else  begin
                if ScopeCol^.Count = 0
                 then  begin
                 { scope is not nil for a list of comma seperated variables
                   who all get the same scope. Search these variables and
                   set their ScopeCol to the ScopeCol of their type}
                   OldScope := ScopeCol;
                   PScopeCol(ScopeStack^.At(ScopeStack^.Count-1))^.ForEach(@SetNewScope);
                 end
                 else  begin
                   writeln('Internal error. Scope of ' + Name^ + ' should be nil.');
                   Halt(1);
                 end;
              end;
           end; { of with }
         end;
       end;
       write(yyoutput, GiveEncodingFor(yytext));
     end
     else  begin
       ObjectName := yytext;
       AbsoluteParsed := FALSE;

     {* check if constant array variable is specified *}
       if (DeclType = _CONST) and (not RightHand) then  begin
         saveyytext := yytext;
         if (yylex = COLON) or (yyretval = EQUAL)
          then  begin
            yyless(0);
            yytext := saveyytext;
          end
          else  begin
            yyless(0);
            write(yyoutput, GiveEncodingFor(saveyytext));
            ConstantArray := TRUE;
            Exit;
          end;
       end;

     { if we are in the interface section, don't encode }
       if GlobalSection = Intr
        then  write(yyoutput, EncodeNot(yytext))
        else
        {* encode the lefthand *}
          write(yyoutput, Encode(yytext));

     { create new scope if COMMA detected, set ConstantRecord if COLON }
       if yylex = COMMA then begin
         CreateCurrentScope;
       end;
       yyless(0);
       if yyretval = COMMA then  begin
         repeat
           if yylex = COMMA
            then  begin
              write(yyoutput, ',');
              yylex;
              if GlobalSection = Intr
               then  write(yyoutput, EncodeNot3(yytext))
               else  write(yyoutput, Encode3(yytext));
            end
            else  break;
         until false;
         yyless(0);
       end;
     end;
  end; { of ParseDeclaration }


  procedure ParseFunctionDeclaration;
  begin
    if RightHand
     then  write(yyoutput, GiveEncodingFor(yytext))
     else  begin
       if (CurrentScope <> nil) and CurrentScope^.Search(@yytext, Index)
        then  begin
          repeat
            write(yyoutput, GiveEncodingFor(yytext));
            if yylex = COMMA
             then  begin
               write(yyoutput, ',');
               yylex;
             end
             else  break;
          until false;
          yyless(0);
        end
        else  begin
          repeat
            if GlobalSection = Intr
             then  write(yyoutput, EncodeNot2(yytext))
             else  write(yyoutput, Encode2(yytext));
            if yylex = COMMA
             then  begin
               writeln(yyoutput, ',');
               yylex;
             end
             else  break;
          until false;
          yyless(0);
        end;
     end;
  end; { of ParseFunctionDeclaration }



var
  LastIdentifier,
  LastPossibleTypeIdentifier,
  PointerName,
  TypeName: string[63];
label l1;
begin
  Scramble := FALSE;

{* open inputfile *}
  FileMode := 0;             {* open inputfile in read-only mode *}
  Assign(yyinput, FromFile);
  Reset(yyinput);
  SetTextBuf(yyinput, Buffer, 1024);

{* open output file *}
  FileMode := 1;             {* open outputfile in write-only mode *}
  Assign(yyoutput, 'NUL');   {* depress output until implemenation section *}
  Rewrite(yyoutput);
  FileMode := 2;             {* restore filemode *}

{* initialize variables *}
  yylineno := 1;
  GlobalSection := Un;
  Section := None;
  SectionStack := New(PSectionCol, Init(50, 10));
  RecordType := rtNone;
  WithPushes := 0;
  OpeningLevel := -1;
  ParenLevel := 0;
  RightHand := FALSE;
  ObjectDecl := FALSE;
  ObjectImpl := FALSE;
  CurrentScope := New(PScopeCol, Init(200, 100));
  ScopeStack := New(PCollection, Init(100, 50));
  ForwardPointerCol := New(PForwardPointerCol, Init(4,4));
  LastScopeIndex := -1;
  AssemblerSection := FALSE;
  TypeDecl := FALSE;
  AbsoluteParsed := FALSE;
  ConstantArray := FALSE;
  TypeCastDetected := False;

{* check if this is a unit *}
  repeat
    case yylex of
      _UNIT : break;
      _PROGRAM : begin
          Close(yyinput);
          Close(yyoutput);
          writeln('This is a program. Mangler can only mangle units. File skipped.');
          Exit;
        end;
    end; { of case }
  until IsClosed(yyinput) or eof(yyinput);
  if IsClosed(yyinput) or eof(yyinput) then  begin
    writeln('File is not a unit. File skipped.');
    Exit;
  end;

{* mangle *}
  write(#13, FromFile, ' (', yylineno, ')');

  while not eof(yyinput) do  begin
    LastRetVal := yyretval;
    case yylex of
      IDENTIFIER : begin
          LastIdentifier := yytext;
          case Section of
            Decl : ParseDeclaration;
            FuncDecl : ParseFunctionDeclaration;
          else  begin
            writeln(yyoutput, GiveEncodingFor(yytext));
          end;
          end; { of case }
        end;
      COLON, EQUAL : begin
          write(yyoutput, yytext);
          case GlobalSection of
            Intr : RightHand := TRUE;
            Impl : begin
                     if (Section = Decl) or (Section in [FuncDecl, FunctionType]) then
                       RightHand := TRUE;
                   end;
          end; { of case }
        end;
      SEMICOLON : begin
          HandleSemiColon;
        end;
      LPAREN : begin
          write(yyoutput, yytext);
          PushSection(Section);
          Inc(ParenLevel);
          OpeningLevel := -1;
          case Section of
            Decl : begin
                if (RecordType = rtVariantRecord) or
                   ((DeclType = _CONST) and (LastRetVal = EQUAL)) then  begin
                  RightHand := FALSE;
                end;
                if (LastRetVal = COLON) or (LastRetVal = EQUAL) then
                  OpeningLevel := ParenLevel-1
              end;
            Func : begin
                Section := FuncDecl;
                RightHand := FALSE;
              end;
          else
            LastPossibleTypeIdentifier := LastIdentifier;
            if TypeCastDetected then  begin
              CurrentScope := PopScope;
              TypeCastDetected := False;
            end;
          end;  { of case }
        end;
      RPAREN : begin
          write(yyoutput, yytext);
          Dec(ParenLevel);
          case Section of
            Decl : begin
                if LastRetVal = LPAREN then  begin
                  PushScope(CurrentScope);
                  RightHand := TRUE;
                end;
              {* execute semicolon code at end of constant record var *}
                if ((DeclType = _CONST) and (ParenLevel = OpeningLevel)) and not ConstantArray then
                  HandleSemiColon;
              end;
            FuncDecl : Section := Func;
          end; { of case }
          Section := PopSection;
          if TypeCastDetected then  begin
            CurrentScope := PopScope;
            TypeCastDetected := False;
          end;
        end;
      ASSIGNMENT,COMMA: begin
          write(yyoutput, yytext);
          if TypeCastDetected then  begin
            CurrentScope := PopScope;
            TypeCastDetected := False;
          end;
        end;
      DOT: begin
          write(yyoutput, yytext);
        { try to catch type casts which are record types and which
          fields are encoded }
          if LastRetVal = RPAREN then  begin
            TypeCastDetected := False;
            Scope := GetScope(LastPossibleTypeIdentifier, i);
            if (Scope <> nil) and (PMangleItem(Scope^.At(i))^.ScopeCol <> nil) then  begin
              TypeCastDetected := True;
              PushScope(CurrentScope);
              CurrentScope := Scope^.AtScope(i);
            end;
          end;
        end;
      _CONST, _TYPE, _VAR : begin
          ForwardPointerCol^.FreeAll;
          write(yyoutput, yytext, ' ');
          if not (Section in [FuncDecl, FunctionType]) then  begin
            Section := Decl;
            TypeDecl := yyretval = _TYPE;
          end;
          RightHand := FALSE;
          DeclType := yyretval;
        end;
      _RECORD : begin
          write(yyoutput, yytext, ' ');
          if Section = Decl then  begin
            RightHand := FALSE;
            RecordType := rtRecord;
          end;
        end;
      _CASE : begin
          write(yyoutput, yytext, ' ');
          case Section of
            Decl : begin
                if RecordType in [rtRecord, rtVariantRecord] then  begin
                  RecordType := rtVariantRecord;
                  RightHand := TRUE;
                  Section := BetweenCaseAndOfDecl;
                end;
              end;
          else  begin
            PushSection(Section);
            Section := CompoundStatement;
          end; { of case-else }
          end; { of case }
        end;
      _BEGIN : begin
          write(yyoutput, yytext, ' ');
          case Section of
            Decl, Func : Section := FuncOuter;
          else  begin
            PushSection(Section);
            Section := CompoundStatement;
          end;
          end; { of case }
        end;
      _END : begin
          if (LastRetVal <> SEMICOLON) and (LastRetVal <> _RECORD)
           then  HandleSemiColon
           else  write(yyoutput, yytext, ' ');
          case GlobalSection of
            Intr : begin
                if ObjectDecl then  begin
                  ObjectDecl := FALSE;
                  Section := Decl;
                end;
                case RecordType of
                  rtRecord : if (ScopeStack^.Count = 1) and (SectionStack^.Count = 0) then
                               RecordType := rtNone;
                  rtVariantRecord : begin
                      RecordType := rtNone;
                    end;
                end;
              end;
            Impl : begin
                if (ScopeStack^.Count = 0) and not (Section = CompoundStatement)
                 then  begin
                   if yylex <> DOT then  begin
                     PrintError('END. expected');
                     Halt1;
                   end;
                   write(yyoutput, yytext);
                   break;
                 end
                 else  begin
                   case Section of
                     Decl : begin
                         if ObjectDecl then
                           ObjectDecl := FALSE;
                         case RecordType of
                           rtRecord : if (ScopeStack^.Count = 1) and (SectionStack^.Count = 0) then  begin
                                        RecordType := rtNone;
                                      end;
                           rtVariantRecord : begin
                               RecordType := rtNone;
                             end;
                         end;
                       end;
                     FuncOuter : begin
                       { remove every scope defined in this proc/func }
                         if CurrentScope <> nil then  begin
                           {CurrentScope^.FreeAll;}

                           i := 0;
                           while i < CurrentScope^.Count do  begin
                             with PMangleItem(CurrentScope^.At(i))^ do
                               if Name^ = HashedName^
                                then  Inc(i)
                                else  CurrentScope^.AtFree(i);
                           end;

                         end;

                         { remove scope for current function itself }
                         CurrentScope := PopScope;

                         if ObjectImpl and (ScopeStack^.Count = 1) then  begin
                           CurrentScope := PopScope;
                           ObjectImpl := FALSE;
                         end;
                         Section := PopSection;
                         if ScopeStack^.Count = 0 then  begin
                           if SectionStack^.Count <> 0 then  begin
                             PrintError('Section stack contains entries when ending outer function definition.');
                             Halt1;
                           end;
                         end;
                       end;
                     CompoundStatement : Section := PopSection;
                   else  PrintError('Unexpected END;');
                   end; { of case }
                 end;
              end;
          end;  { of case }
        end;
      _PROCEDURE, _FUNCTION, _CONSTRUCTOR, _DESTRUCTOR : begin
{$IFDEF ShowProcs}
          writeln(ScopeStack^.Count, '  ', yyline);
{$ENDIF}
          write(yyoutput, yytext, ' ');
          if not ((Section = Decl) and RightHand and not ObjectDecl)
           then  yylex  {* get name *}
           else  yytext := '';
          Section := Func;
          if yytext = '' then  begin
            Section := FunctionType;
            continue;
          end;
          case GlobalSection of
            Intr : begin
                writeln(yyoutput, yytext);
                if yytext = ''
                 then  CurrentScope^.InsertIntrIdentifier(ObjectName, LastScopeIndex)
                 else  CurrentScope^.InsertIntrIdentifier(yytext, LastScopeIndex);
                PushScope(CurrentScope);
                CurrentScope := CurrentScope^.AtScope(LastScopeIndex);
              end;
            Impl : begin
                if yytext = '' then
                  continue;
                if not ObjectDecl then
                  PushSection(Section);
                if (CurrentScope <> nil) and CurrentScope^.Search(@yytext, Index)
                 then  begin
                 {* already declared *}
                   write(yyoutput, CurrentScope^.AtHashedName(Index));
                   PushScope(CurrentScope);
                   CurrentScope := CurrentScope^.AtScope(Index);
                   if yylex = DOT
                    then  begin
                    {* object declaration *}
                      ObjectImpl := TRUE;
                      write(yyoutput, yytext);
                      yylex;      {* get object name *}
                      CurrentScope^.Search(@yytext, LastScopeIndex);
                      writeln(yyoutput, CurrentScope^.AtHashedName(LastScopeIndex));
                      PushScope(CurrentScope);
                      CurrentScope := CurrentScope^.AtScope(LastScopeIndex);
                    end
                    else  begin
                    {* normal funtion or procedure *}
                      writeln(yyoutput);
                      yyless(0);
                      LastScopeIndex := Index;
                    end;
                 end
                 else  begin
                 {* new definition *}
                   if ObjectDecl
                    then  writeln(yyoutput, EncodeNot(yytext))
                    else  writeln(yyoutput, Encode(yytext));
                 end;
              end;
          end;  { of case }
        end;
      _FORWARD, _EXTERNAL : begin
          write(yyoutput, yytext);
          CurrentScope := PopScope;
          Section := PopSection;
        end;
      _INLINE : begin
          write(yyoutput, yytext);
          if (Section = Func) or (GlobalSection= Intr) then
            Section := Inlin;
        end;
      _VIRTUAL : begin
          write(yyoutput, yytext);
          Section := Decl;
          RightHand := FALSE;
          yylex;   {* get SEMICOLON *}
          writeln(yyoutput, yytext);
        end;
      _OBJECT : begin
          if SectionStack^.Count <> 0 then  begin
            PrintError('Section stack contains entries when starting to parse object definition.');
            Halt1;
          end;
          if ScopeStack^.Count > 1 then  begin
            PrintError('Scope stack contains two or more entries when starting to parse object definition.');
            Halt1;
          end;
          write(yyoutput, yytext, ' ');
          Section := Decl;
          RightHand := FALSE;
          ObjectDecl := TRUE;
          CreateCurrentScope;
          if GlobalSection in [Intr, Impl] then  begin
            if yylex = LPAREN
             then  begin
               write(yyoutput, yytext);
               yylex;        {* read parent *}
               Scope := GetScope(yytext, Index);
               write(yyoutput, GiveEncodingFor(yytext));
               yylex;        {* read RPAREN *}
               write(yyoutput, yytext);
               if (Scope <> nil) and (Scope^.AtScope(Index) <> nil) then  begin
                 Scope := Scope^.AtScope(Index);
                 for i := 0 to Scope^.Count-1 do
                   CurrentScope^.Insert(Scope^.At(i));
               end;
             end
             else  yyless(0);
          end;
        end;
      _PRIVATE : begin
          writeln(yyoutput, yytext);
          Section := Decl;
          RightHand := FALSE;
        end;

      _INHERITED : begin
          write(yyoutput, yytext, ' ');
          yylex;   {* get identifier, but mangle it not *}
          write(yyoutput, yytext, ' ');
        end;
      _WITH : begin
          write(yyoutput, yytext, ' ');
          PushSection(Section);
          WithPushes := 0;
          repeat
            yylex;
            Scope := GetScope(yytext, i);
            if Scope <> nil then  begin
              PushScope(CurrentScope);
              CurrentScope := Scope^.AtScope(i);
              Inc(WithPushes);
            end;
            write(yyoutput, GiveEncodingFor(yytext));
          l1:
            case yylex of
              _DO : break;
              COMMA : write(yyoutput, yytext);
              UPARROW : begin
                  write(yyoutput, yytext);
                  case yylex of
                    _DO : break;
                    COMMA : write(yyoutput, yytext);
                    LBRAC : begin
                               repeat
                                 writeln(yyoutput, yytext);
                               until yylex = RBRAC;
                               writeln(yyoutput, yytext);
                               if yylex = _DO
                                then  begin
                                  write(yyoutput, ' ', yytext);
                                  break;
                                end
                                else  yyless(0);
                             end;
                  end; { of case }
                end;
              LPAREN : begin
                  write(yyoutput, yytext);
                {* function or type override encountered *}
                  Paren := 1;
                  repeat
                    case yylex of
                      LPAREN : begin Inc(Paren); write(yyoutput, yytext); end;
                      RPAREN : begin Dec(Paren);  write(yyoutput, yytext); end;
                      IDENTIFIER : write(yyoutput, GiveEncodingFor(yytext));
                    else  write(yyoutput, yytext);
                    end;
                  until Paren = 0;
                  goto l1;
                end;
              LBRAC : begin
                  write(yyoutput, yytext);
                {* array encountered *}
                  repeat
                    case yylex of
                      IDENTIFIER : writeln(yyoutput, GiveEncodingFor(yytext));
                      RBRAC : break;
                    else  write(yyoutput, yytext);
                    end; { of case }
                  until false;
                  write(yyoutput, yytext);
                  goto l1;
                end;
            else  begin
              PrintError('Unexpected WITH form.');
              Halt1;
            end;
            end; { of case }
          until false;
          write(yyoutput, ' DO ');
          Section := WithStatement;
        end;
      _ASM : ParseAsm;
      _ASSEMBLER : begin
          write(yyoutput, yytext);
          AssemblerSection := TRUE;
        end;
      _FOR, _WHILE : begin
          write(yyoutput, yytext, ' ');
        end;
      _ABSOLUTE : begin
          write(yyoutput, ' ', yytext, ' ');
          AbsoluteParsed := TRUE;
        end;
      _DO, _OF : begin
          write(yyoutput, ' ', yytext, ' ');
          if Section = BetweenCaseAndOfDecl then
            Section := Decl;
        end;
      CHARACTER_STRING : begin
          write(yyoutput, yytext);
          while yylex = _CHAR do
            write(yyoutput, yytext);
          yyless(0);
        end;
      _CHAR : write(yyoutput, yytext);
      UPARROW : begin
          write(yyoutput, yytext);
          if GlobalSection = Impl then  begin
            if (Section = Decl) and TypeDecl
              then  begin
                yylex;      {* get identifier *}

                {* if already declared, no problem, else it is a forward *}
                {* pointer which should not be scrambled *}
                if GetScope(yytext, Index) = nil
                  then  begin
                    PointerName := LastIdentifier;
                    TypeName := yytext;
                    with ScopeStack^ do
                      PScopeCol(At(Count-1))^.InsertIdentifier(yytext, Index);
                    ForwardPointerCol^.InsertItem(PointerName, TypeName);
                  end
                  else  begin
                  end;

                yyless(0)   {* return read characters *}
              end
              else  begin
                Scope := GetScope(LastIdentifier, i);
                if Scope <> nil then  begin
                  PushScope(CurrentScope);
                  CurrentScope := Scope^.AtScope(i);
                  if (CurrentScope <> nil) and (CurrentScope^.Count > 0)
                    then
                      TypeCastDetected := True   { ahem }
                    else
                      CurrentScope := PopScope;
                end;
              end;
          end;
        end;
      _ARRAY : begin
          writeln(yyoutput, yytext);
          ConstantArray := DeclType = _CONST;
        end;
      _FAR, _NEAR : begin
          write(yyoutput, yytext);
          if yylex = SEMICOLON
           then  write(yyoutput, ';')
           else  begin
             write(yyoutput, ' ');
             yyless(0);
           end;
        end;
      _LABEL : begin
          Section := LabelStatement;
          write(yyoutput, yytext, ' ');
        end;
      DIRECTIVE : begin
          write(yyoutput, yytext);
        end;
      _INTERFACE : begin
          write(yyoutput, yytext, ' ');
          GlobalSection := Intr;
        end;
      _IMPLEMENTATION : begin
          if SectionStack^.Count <> 0 then  begin
            PrintError('Internal error: section stack contains entries when starting to parse implementation.');
            Halt1;
          end;
(*
          if ScopeStack^.Count <> 0 then  begin
            PrintError('Internal error: scope stack contains entries when starting to parse implementation.');
            Halt1;
          end;
*)

        {* close temporary output file *}
          Close(yyoutput);

        {* open temporary output file for mangled implementation section *}
          FileMode := 1;             {* open outputfile in write-onlymode *}
          Assign(yyoutput, ToFile);
          Rewrite(yyoutput);
          FileMode := 2;             {* restore filemode *}

          ImplementationLineNumber := yylineno;
          write(yyoutput, yytext, ' ');
          GlobalSection := Impl;
          Section := None;
        end;
    else  writeln(yyoutput, yytext);
    end;  { of case }
  end;  { of while }

  if ScopeStack^.Count <> 0 then  begin
    PrintError('Unexpected end of file');
    Close(yyinput);
    Close(yyoutput);
    Exit;
  end;

{* dispose variables *}
(* can't be disposed
  Dispose(CurrentScope, Done);
*)
  Dispose(ScopeStack, Done);
  Dispose(SectionStack, Done);

{* close files *}
  WriteProgress;
  Close(yyinput);
  Close(yyoutput);

  Scramble := TRUE;
end;


var
  crunched_line_no : integer;

procedure Crunch(OrgFile, FromFile, ToFile : FNameStr);
{* rewrites a file in as few lines as possible *}
const
  BufferSize = 1024;
var
  Buffer : array[1..BufferSize] of char;
  LineNumber : word;
  d, s : string;
begin
  Assign(yyoutput, ToFile);
  Rewrite(yyoutput);
  writeln(yyoutput, '(* This file was mangled by Mangler ', Version, ' (c) Copyright 1993-1994 by Berend de Boer *)');

{* write interface section *}
  Assign(yyinput, OrgFile);
  Reset(yyinput);
  SetTextBuf(yyinput, Buffer, BufferSize);
  LineNumber := 2;
  while LineNumber <> ImplementationLineNumber do  begin
    readln(yyinput, s);
    writeln(yyoutput, s);
    Inc(LineNumber);
  end;
  Close(yyinput);

{* rewrite mangled implementation section in fewer lines *}
  Assign(yyinput, FromFile);
  Reset(yyinput);
  SetTextBuf(yyinput, Buffer, BufferSize);

{* and crunch it *}
  d := '';
  crunched_line_no := 1;
  while not eof(yyinput) do  begin
    readln(yyinput, s);
    if length(d) + length(s) <= LineWidth
     then  begin
       if d[length(d)] = ';'
        then  d := d + s
        else
          if s <> '' then  d := d + ' ' + s;
     end
     else  begin
       Inc(crunched_line_no);
       writeln(yyoutput, d);
       d := s;
     end;
  end;  { of while }
  writeln(yyoutput, d);

{* close files *}
  Close(yyinput);
  Close(yyoutput);
end;



function MatchFileNames(const Source, Dest : PathStr) : string;
{* Source and Dest are made equal everywhere Dest contains a '?' *}
var
  p : word;
  i : integer;
  SourceDir, DestDir : DirStr;
  SourceName, DestName : NameStr;
  SourceExt, DestExt : ExtStr;
begin
  FSplit(Source, SourceDir, SourceName, SourceExt);
  FSplit(Dest, DestDir, DestName, DestExt);

{* match name *}
  if DestName = ''
   then  DestName := SourceName
   else  begin
     p := Pos('*', DestName);
     if p > 0
      then  begin
        Delete(DestName, p, length(DestName));
        DestName := DestName + Copy(SourceName, p, length(SourceName));
      end
      else  begin
        p := Pos('?', DestName);
        if p > 0 then  begin
          for i := p to length(DestName) do
            if (DestName[i] = '?') and (i <= length(SourceName)) then
              DestName[i] := SourceName[i]
        end;
      end;
   end;

{* match ext *}
  if DestExt = ''
   then  DestExt := SourceExt
   else  begin
     p := Pos('*', DestExt);
     if p > 0
      then  begin
        Delete(DestExt, p, length(DestExt));
        DestExt := DestExt + Copy(SourceExt, p, length(SourceExt));
      end
      else  begin
        p := Pos('?', DestExt);
        if p > 0 then  begin
          for i := p to length(DestExt) do
            if (DestExt[i] = '?') and (i <= length(SourceExt)) then
              DestExt[i] := SourceExt[i]
        end;
      end;
   end;

  MatchFileNames := DestDir + DestName + DestExt;
end;



var
  File1, File2 : byte;
  destDir : DirStr;
  sourceName, destName : NameStr;
  sourceExt, destExt : ExtStr;
  tmpFileName : PathStr;
  DestFileName : PathStr;
  s : string;
  code : word;

begin
  Close(Output);
  Assign(Output, '');
  Rewrite(Output);
  writeln(#13+'Source code Mangler ', Version, ', (c) Copyright 1993-1994 by Berend de Boer.');
{$IFDEF Debug}
  InitBBError('MANGLER.LOG', TRUE);
  InitMemCheck(mfStandard);
  InitObjMemory;
  InitPMD(dfStandard);
{$ENDIF}
  if (ParamCount < 2) or (ParamCount > 3) then  begin
    writeln('Parameter error.');
    writeln('Usage:');
    writeln('MANGLER [options] sourcefile(s) destfile(s)');
    writeln('Wildcards are supported.');
    writeln('Options:');
    writeln('-w[number]  outputted maximum line width');
    Halt(1);
  end;

  if ParamCount = 3
   then  begin
     if Copy(ParamStr(1), 1, 2) <> '-w' then  begin
       writeln('Error parsing options.');
       Halt(1);
     end;
     s := ParamStr(1);
     System.Delete(s, 1, 2);
     Val(s, LineWidth, code);
     if code <> 0 then  begin
       writeln('Incorrect line width.');
       Halt(1);
     end;
     File1 := 2;
     File2 := 3;
   end
   else  begin     {* ParamCount = 2 *}
     File1 := 1;
     File2 := 2;
   end;

  if ParamStr(File1) = ParamStr(File2) then  begin
    writeln('Source file(s) equal(s) destination file(s). Mangler halted.');
    Halt(1);
  end;

{* install error procedure *}
  ExitSave := ExitProc;
  ExitProc := @ExitHandler;

{* close files opened by LexLib *}
  Close(yyinput);
  Close(yyoutput);

  Randomize;

{* split source name *}
  FSplit(ParamStr(File1), sourceDir, sourceName, sourceExt);

{* split dest name *}
  FSplit(ParamStr(File2), destDir, destName, destExt);

{* FindFirst/FindNext loop *}
  FindFirst(ParamStr(File1), Archive, DirInfo);

  if DosError <> 0 then
    writeln('Source file(s) not found.');

  while DosError = 0 do  begin

  {* name of intermediate file *}
    tmpFileName := MatchFileNames(DirInfo.Name, destDir + destName + '.$$$');

  {* destination filename *}
    DestFileName := MatchFileNames(DirInfo.Name, destDir+destName+destExt);

    if sourceDir+DirInfo.Name = DestFileName
     then  writeln('Source file equals destination file. File ', sourceDir+DirInfo.Name, ' skipped.')
     else  begin

     {* Pass 1, scramble file *}
       writeln('Pass 1: Scrambling');
       write(DirInfo.Name, '(0)');

     {* scramble to temporary file *}
       if Scramble(sourceDir+DirInfo.Name, tmpFileName) then  begin

{$IFDEF Crunch}
       {* pass 2, rewrite the mangled code in as few lines as possible *}
         writeln;
         writeln('Pass 2: Crunching');

       {* open temporary file and create the real destination file *}
         Crunch(sourceDir+DirInfo.Name, tmpFileName, DestFileName);
         writeln('File crunched from ', yylineno-1, ' lines to ', crunched_line_no, ' lines');
         Erase(yyinput);     {* erase temporary file *}
{$ENDIF}
       end;
     end;

    FindNext(DirInfo);
  end;  { of while }

end.